home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / mmacro.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  6.6 KB  |  215 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module mmacro)
  13.  
  14. ; Exported functions are MDEFMACRO, $MACROEXPAND, $MACROEXPAND1, MMACRO-APPLY
  15. ;                        MMACROEXPANDED, MMACROEXPAND and MMACROEXPAND1
  16.  
  17.  
  18. (declare-top (SPECIAL $MACROS $FUNCTIONS $TRANSRUN $TRANSLATE))
  19.  
  20.  
  21. ;; $MACROS declared in jpg;mlisp >
  22.  
  23.  
  24. (DEFMVAR $MACROEXPANSION ()
  25.      "Governs the expansion of Macsyma Macros.  The following settings are
  26. available:  FALSE means to re-expand the macro every time it gets called.
  27. EXPAND means to remember the expansion for each individual call do that it 
  28. won't have to be re-expanded every time the form is evaluated.  The form will 
  29. still grind and display as if the expansion had not taken place.  DISPLACE
  30. means to completely replace the form with the expansion.  This is more space
  31. efficient than EXPAND but grinds and displays the expansion instead of the
  32. call."
  33.          MODIFIED-COMMANDS '($MACROEXPAND)
  34.          SETTING-LIST      '( () $EXPAND $DISPLACE ) )
  35.  
  36.  
  37.  
  38.  
  39.  
  40. ;;; LOCAL MACRO ;;;
  41.  
  42. (DEFMACRO COPY1CONS (NAME) `(CONS (CAR ,NAME) (CDR ,NAME)))
  43.  
  44.  
  45.  
  46.  
  47. ;;; DEFINING A MACRO ;;;
  48.  
  49.  
  50. (DEFMSPEC MDEFMACRO (FORM) (SETQ FORM (CDR FORM))
  51.   (COND ((OR (NULL (CDR FORM)) (CDDDR FORM))
  52.      (MERROR "Wrong number of args to ::= ~%~M"
  53.          `((MDEFMACRO) ,@FORM))
  54.      )
  55.     (T (MDEFMACRO1 (CAR FORM) (CADR FORM)))))
  56.  
  57.  
  58. (DEFUN MDEFMACRO1 (FUN BODY)
  59.   (LET ((NAME) (ARGS))
  60.      (COND ((OR (ATOM FUN)
  61.         (NOT (ATOM (CAAR FUN)))                
  62.         (MEMQ 'array (CDAR FUN))              
  63.         (MOPP (SETQ NAME ($VERBIFY (CAAR FUN))))
  64.         (MEMQ NAME '($ALL $% $%% MQAPPLY)))
  65.         (MERROR "Illegal macro definition: ~M"    ;ferret out all the
  66.             FUN))                ;  illegal forms
  67.        ((NOT (EQ NAME (CAAR FUN)))                 ;efficiency hack I guess
  68.         (RPLACA (CAR FUN) NAME)))                  ;  done in jpg;mlisp
  69.      (SETQ ARGS (CDR FUN))                             ;  (in MDEFINE).
  70.      (MREDEF-CHECK NAME)
  71.      (DO ((A ARGS (CDR A)) (MLEXPRP))
  72.      ((NULL A)
  73.       (REMOVE1 (NCONS NAME) 'MEXPR T $FUNCTIONS T) ;do all arg checking,
  74.       (COND (MLEXPRP (MPUTPROP NAME T 'MLEXPRP))   ; then remove MEXPR defn
  75.         (T (ARGS NAME (CONS () (LENGTH ARGS))))))
  76.      (COND ((MDEFPARAM (CAR A)))
  77.            ((AND (MDEFLISTP A)
  78.              (MDEFPARAM (CADR (CAR A))))
  79.         (SETQ MLEXPRP T))
  80.            (T 
  81.           (MERROR "Illegal parameter in macro definition: ~M"
  82.               (CAR A)))))
  83.      (REMOVE-TRANSL-FUN-PROPS NAME)
  84.      (ADD2LNC `((,NAME) ,@ARGS) $MACROS)
  85.      (MPUTPROP NAME (MDEFINE1 ARGS BODY) 'MMACRO)
  86.      
  87.      (COND ($TRANSLATE (TRANSLATE-AND-EVAL-MACSYMA-EXPRESSION
  88.             `((MDEFMACRO) ,FUN ,BODY))))
  89.      `((MDEFMACRO SIMP) ,FUN ,BODY)))
  90.  
  91.  
  92.  
  93.  
  94. ;;; EVALUATING A MACRO CALL ;;;
  95.  
  96.  
  97. (DEFMFUN MMACRO-APPLY (DEFN FORM)
  98.   (MMACROEXPANSION-CHECK FORM
  99.              (IF (AND (ATOM DEFN)
  100.                   (NOT (SYMBOLP DEFN)))
  101.                  ;; added this clause for NIL. MAPPLY
  102.                  ;; doesn't really handle applying interpreter
  103.                  ;; closures and subrs very well.
  104.                  (APPLY DEFN (CDR FORM))
  105.                  (MAPPLY1 DEFN (CDR FORM) (CAAR FORM) form))))
  106.  
  107.  
  108.  
  109.  
  110. ;;; MACROEXPANSION HACKERY ;;;
  111.  
  112.  
  113. ; does any reformatting necessary according to the current setting of
  114. ; $MACROEXPANSION.  Note that it always returns the expansion returned
  115. ; by displace, for future displacing.
  116.  
  117. (DEFUN MMACROEXPANSION-CHECK (FORM EXPANSION)
  118.   (CASE $MACROEXPANSION
  119.      (( () )
  120.       (COND ((EQ (CAAR FORM) 'MMACROEXPANDED)
  121.          (MMACRO-DISPLACE FORM EXPANSION))
  122.         (T EXPANSION)))
  123.      (($EXPAND)
  124.       (COND ((NOT (EQ (CAAR FORM) 'MMACROEXPANDED))
  125.          (DISPLACE FORM `((MMACROEXPANDED) 
  126.                   ,EXPANSION
  127.                   ,(COPY1CONS FORM)))))
  128.       EXPANSION)
  129.      (($DISPLACE)
  130.       (MMACRO-DISPLACE FORM EXPANSION))
  131.      (T (MTELL "Warning:  MACROEXPANSION set to unrecognized value."))))
  132.  
  133.  
  134. (DEFUN MMACRO-DISPLACE (FORM EXPANSION)
  135.        (DISPLACE FORM (COND ((ATOM EXPANSION) `((MPROGN) ,EXPANSION))
  136.                 (T EXPANSION))))
  137.  
  138.  
  139. ; Handles memo-ized forms.  Reformats them if $MACROEXPANSION has changed.
  140. ; Format is ((MMACROEXPANDED) <expansion> <original form>)
  141.  
  142. (DEFMSPEC MMACROEXPANDED (FORM)
  143.   (MEVAL (MMACROEXPANSION-CHECK FORM (CADR FORM))))
  144.  
  145.  
  146. ;;; MACROEXPANDING FUNCTIONS ;;;
  147.  
  148.  
  149. (DEFMSPEC $MACROEXPAND (FORM) (SETQ FORM (CDR FORM))
  150.   (COND ((OR (NULL FORM) (CDR FORM))
  151.      (MERROR "MACROEXPAND only takes one argument:~%~M"
  152.          `(($MACROEXPAND) ,@FORM)))
  153.     (T (MMACROEXPAND (CAR FORM)))))
  154.  
  155. (DEFMSPEC $MACROEXPAND1 (FORM) (SETQ FORM (CDR FORM))
  156.   (COND ((OR (NULL FORM) (CDR FORM))
  157.      (MERROR "MACROEXPAND only takes one argument: ~%~M"
  158.          `(($MACROEXPAND1) ,@FORM)))
  159.     (T (MMACROEXPAND1 (CAR FORM)))))
  160.  
  161.  
  162. ; Expands the top-level form repeatedly until it is no longer a macro
  163. ; form.  Has to copy the form each time because if macros are displacing
  164. ; the form given to mmacroexpand1 will get bashed each time.  Recursion
  165. ; is used instead of iteration so the user gets a pdl overflow error
  166. ; if he tries to expand recursive macro definitions that never terminate.
  167.  
  168. (DEFUN MMACROEXPAND (FORM)
  169.   (LET ((TEST-FORM (IF (ATOM FORM) FORM (COPY1CONS FORM)))
  170.     (EXPANSION (MMACROEXPAND1 FORM)))
  171.        (COND ((EQUAL EXPANSION TEST-FORM)
  172.           EXPANSION)
  173.          (T (MMACROEXPAND EXPANSION)))))
  174.  
  175.  
  176. ; only expands the form once.  If the form is not a valid macro
  177. ; form it just gets returned (eq'ness is preserved).  Note that if the
  178. ; macros are displacing, the returned form is also eq to the given
  179. ; form (which has been bashed).
  180.  
  181. (DEFUN MMACROEXPAND1 (FORM)
  182.  (LET ((FUNNAME) (MACRO-DEFN))
  183.   (COND ((OR (ATOM FORM)
  184.          (ATOM (CAR FORM))
  185.          (MEMQ 'array (CDAR FORM))
  186.          (NOT (SYMBOLP (SETQ FUNNAME (MOP FORM)))))
  187.      FORM)
  188.     ((EQ FUNNAME 'MMACROEXPANDED)
  189.      (MMACROEXPANSION-CHECK FORM (CADR FORM)))
  190.     ((SETQ MACRO-DEFN
  191.            (OR (AND $TRANSRUN 
  192.             (GET (CAAR FORM) 'TRANSLATED-MMACRO))
  193.            (MGET (CAAR FORM) 'MMACRO)))
  194.      (MMACRO-APPLY MACRO-DEFN FORM))
  195.     (T FORM))))
  196.  
  197.  
  198.  
  199. ;;; SIMPLIFICATION ;;;
  200.  
  201. (DEFPROP MDEFMACRO SIMPMDEFMACRO OPERATORS)
  202.  
  203. ; emulating simpmdef (for mdefine) in jm;simp
  204. (DEFMFUN SIMPMDEFMACRO (X *IGNORED* SIMP-FLAG)
  205.      *IGNORED* ;Ignored.
  206.      SIMP-FLAG ;No interesting sub-expressions.
  207.      (CONS '(MDEFMACRO SIMP) (CDR X)))
  208.  
  209.  
  210. #+(or cl NIL)
  211. (DEFUN DISPLACE (X Y)
  212.   (SETF (CAR X) (CAR Y))
  213.   (SETF (CDR X) (CDR Y))
  214.   X)
  215.